home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1996
/
MacHack 1996.toast
/
Hacks
/
Hacks ’90
/
DataStack Filer
/
DataStacks.Mod
< prev
next >
Wrap
Text File
|
1995-09-10
|
21KB
|
804 lines
IMPLEMENTATION MODULE DataStacks;
(* Copyright: © 1990 by Keith Nemitz, all rights reserved. *)
FROM SYSTEM IMPORT ADR,ADDRESS;
FROM MacTypes IMPORT Ptr,OSErr,Str31,StringPtr,debugstr;
FROM MemoryManager IMPORT NewPtr,DisposPtr,NewHandle,DisposHandle,MemError,
MoveHHi,HLock,HUnlock,BlockMove,GetHandleSize,SetHandleSize,noErr;
FROM FileManager IMPORT FSRead,FSWrite,Allocate;
FROM LocLib IMPORT CopyStr;
TYPE
GrowStack = POINTER TO GrowStackPtr;
GrowStackPtr = POINTER TO GrowStackRec;
GrowStackRec = RECORD
dataPtr :Ptr;
filledCards :CARDINAL; (* last index in grow space. *)
growStk :GrowStack;
END;
DataKeysHnd = POINTER TO DataKeysPtr;
DataKeysPtr = POINTER TO ARRAY [0..0] OF CARDINAL;
(* cardinal points to block in dataStack.
if point beyond main stack
then count grow stacks to resolve lookup. *)
DataStack = POINTER TO DataStackPtr;
DataStackPtr = POINTER TO DataStackRec;
DataStackRec = RECORD
cardSize :CARDINAL; (* contains size requested + SIZE(header) *)
initialCards :CARDINAL;
growCards :CARDINAL;
filledCards :CARDINAL; (* last index in initial space. *)
totalFilled :CARDINAL; (* last index of all cards. *)
idCount :LONGCARD;
dataPtr :Ptr;
idKeys :DataKeysHnd;
nameKeys :DataKeysHnd;
growStk :GrowStack;
END;
HeadPtr = POINTER TO CardHeader;
CardHeader = RECORD
cName :Str31; (* code requires cName is first in record. *)
id :LONGCARD;
(* stuff *)
END;
CONST
headerSize = SIZE(CardHeader);
PROCEDURE AllocContig(refNum:INTEGER; VAR count:LONGINT):OSErr; EXTERNAL PASCAL;
PROCEDURE IUCompString(aStrPtr, bStrPtr: ADDRESS): INTEGER; EXTERNAL PASCAL;
PROCEDURE NewDataStack(cSize,initial,grow:CARDINAL):DataStack;
VAR
dPtr :Ptr;
dataInfo :DataStack;
idArr,nameArr :DataKeysHnd;
BEGIN
dataStackErr := noErr;
IF (MAX(CARDINAL)-cSize) < headerSize THEN
dataStackErr := cardSizeTooBig;
RETURN NIL;
END;
INC(cSize,headerSize);
dPtr := NewPtr(VAL(LONGINT,cSize * initial));
IF dPtr = NIL THEN
dataStackErr := MemError();
RETURN NIL;
END;
idArr := NewHandle(VAL(LONGINT,initial)*SIZE(CARDINAL) +SIZE(CARDINAL));
nameArr := NewHandle(VAL(LONGINT,initial)*SIZE(CARDINAL) +SIZE(CARDINAL));
IF nameArr = NIL THEN
dataStackErr := MemError();
DisposHandle(idArr);
DisposPtr(dPtr);
RETURN NIL;
END;
dataInfo := NewHandle(SIZE(DataStackRec));
IF dataInfo = NIL THEN
dataStackErr := MemError();
DisposHandle(idArr);
DisposHandle(nameArr);
DisposPtr(dPtr);
RETURN NIL;
END;
WITH dataInfo^^ DO
initialCards := initial;
growCards := grow;
cardSize := cSize;
filledCards := 0;
totalFilled := 0;
idCount := 0;
dataPtr := dPtr;
idKeys := idArr;
nameKeys := nameArr;
growStk := NIL;
END; (*with*)
RETURN dataInfo;
END NewDataStack;
PROCEDURE LoadKeyArrays(idArr,nameArr:DataKeysHnd; n:CARDINAL; fid:INTEGER):BOOLEAN;
VAR
count,count2 :LONGINT;
BEGIN
dataStackErr := noErr;
count := VAL(LONGINT,n)*SIZE(CARDINAL) + SIZE(CARDINAL);
count2 := count;
dataStackErr := FSRead(fid,count,idArr^);
IF dataStackErr # 0 THEN RETURN FALSE; END;
dataStackErr := FSRead(fid,count2,nameArr^);
IF dataStackErr # 0 THEN RETURN FALSE; END;
RETURN TRUE;
END LoadKeyArrays;
PROCEDURE LoadDataStack(fRefNum:INTEGER):DataStack;
VAR
dataStkR :DataStackRec;
dataStk :DataStack;
count :LONGINT;
BEGIN
dataStackErr := noErr;
(* load header *)
count := SIZE(DataStackRec);
dataStackErr := FSRead(fRefNum,count,ADR(dataStkR));
IF dataStackErr # 0 THEN RETURN NIL; END;
(* new data stack *)
WITH dataStkR DO
dataStk := NewDataStack(cardSize,initialCards,growCards);
END;
IF dataStk = NIL THEN RETURN NIL; END;
WITH dataStk^^ DO
filledCards := dataStkR.filledCards;
totalFilled := dataStkR.filledCards;
idCount := dataStkR.idCount;
IF NOT LoadKeyArrays(idKeys,nameKeys,totalFilled,fRefNum) THEN
DisposeDataStack(dataStk);
RETURN NIL;
END;
(* load body *)
count := VAL(LONGINT,cardSize * filledCards);
dataStackErr := FSRead(fRefNum,count,dataPtr);
END;(*with*)
IF dataStackErr # 0 THEN
DisposeDataStack(dataStk);
RETURN NIL;
END;(*with*)
RETURN dataStk;
END LoadDataStack;
PROCEDURE WriteGrowStacks(gStk :GrowStack; cardSize:CARDINAL; fRefNum:INTEGER);
VAR count :LONGINT;
BEGIN
IF gStk = NIL THEN RETURN; END;
WITH gStk^^ DO
count := VAL(LONGINT,filledCards * cardSize);
dataStackErr := FSWrite(fRefNum,count,dataPtr);
IF dataStackErr # 0 THEN RETURN; END;
END;
WriteGrowStacks(gStk^^.growStk,cardSize,fRefNum);
END WriteGrowStacks;
PROCEDURE DumpDataStack(stack:DataStack; fRefNum:INTEGER):BOOLEAN;
VAR
err :OSErr;
dataStkR :DataStackRec;
count,count2 :LONGINT;
BEGIN
dataStackErr := noErr;
(* verify disk space *)
WITH stack^^ DO
IF totalFilled < filledCards THEN RETURN FALSE; END;
count := SIZE(DataStackRec) + ( VAL(LONGINT,cardSize) * VAL(LONGINT,totalFilled) );
INC(count,VAL(LONGINT,totalFilled)*4); (* space for both keys arrays *)
count2 := count;
END;
err := AllocContig(fRefNum,count);
IF err # 0 THEN
dataStackErr := Allocate(fRefNum,count2);
IF dataStackErr # 0 THEN RETURN FALSE; END;
END;
dataStkR := stack^^; (* save copy of dataStackRecord. *)
WITH dataStkR DO
DEC(cardSize,headerSize); (* rebuild DataStack when restored with orig. size. *)
filledCards := totalFilled; (* when restored, filled = total. *)
IF initialCards < totalFilled THEN
initialCards := totalFilled;
END;
END;(*with*)
(* write header *)
count := SIZE(DataStackRec);
dataStackErr := FSWrite(fRefNum,count,ADR(dataStkR));
IF dataStackErr # 0 THEN RETURN FALSE; END;
(* write keys arrays *)
WITH stack^^ DO
count := VAL(LONGINT,totalFilled)*SIZE(CARDINAL) + SIZE(CARDINAL);
count2 := count;
dataStackErr := FSWrite(fRefNum,count,idKeys^);
IF dataStackErr # 0 THEN RETURN FALSE; END;
dataStackErr := FSWrite(fRefNum,count2,nameKeys^);
IF dataStackErr # 0 THEN RETURN FALSE; END;
END; (*with*)
(* write stack *)
WITH stack^^ DO
count := VAL(LONGINT,filledCards * cardSize);
dataStackErr := FSWrite(fRefNum,count,dataPtr);
IF dataStackErr # 0 THEN RETURN FALSE; END;
END;
(* write grow stacks *)
WriteGrowStacks(stack^^.growStk,stack^^.cardSize,fRefNum);
IF dataStackErr # noErr THEN RETURN FALSE; END;
RETURN TRUE;
END DumpDataStack;
PROCEDURE DisposeDataStack(stack:DataStack);
VAR gs,tgs :GrowStack;
BEGIN
DisposPtr(stack^^.dataPtr);
DisposHandle(stack^^.idKeys);
DisposHandle(stack^^.nameKeys);
gs := stack^^.growStk;
WHILE gs # NIL DO
tgs := gs;
DisposPtr(gs^^.dataPtr);
gs := gs^^.growStk;
DisposHandle(tgs);
END;
DisposHandle(stack);
END DisposeDataStack;
(* ***************************** card routines ******************************** *)
PROCEDURE FindGrowHeaderAddr(gStk:GrowStack; cardNum0,cSize:CARDINAL):HeadPtr;
BEGIN
WITH gStk^^ DO
IF cardNum0 >= filledCards THEN
RETURN FindGrowHeaderAddr(growStk,cardNum0-filledCards,cSize);
ELSE
RETURN VAL(ADDRESS, VAL(LONGCARD,cSize) * VAL(LONGCARD,cardNum0)) +
VAL(ADDRESS, dataPtr);
END;
END;
END FindGrowHeaderAddr;
PROCEDURE GetHeaderAddr(stack:DataStack; cardNum:CARDINAL):HeadPtr;
BEGIN
IF stack = NIL THEN RETURN NIL END;
IF (cardNum < 1) OR (cardNum > stack^^.totalFilled) THEN RETURN NIL; END;
DEC(cardNum); (* gives 0 based indexing to cardHeader *)
WITH stack^^ DO
IF cardNum >= filledCards THEN
RETURN FindGrowHeaderAddr(growStk,cardNum-filledCards,cardSize);
ELSE
RETURN VAL( ADDRESS,VAL(LONGCARD,cardNum) * VAL(LONGCARD,cardSize) )
+ VAL(ADDRESS, dataPtr);
END;
END;
END GetHeaderAddr;
(* ************************** search routines ***************************** *)
VAR
theKeyIndex :CARDINAL; (* index of last compare before return/failure *)
theSearchID :LONGCARD;
theSearchName :StringPtr;
theStack :DataStack; (* stack to be searched *)
PROCEDURE SearchStackByName(min,max :CARDINAL):CARDINAL;
VAR
strPtr :StringPtr;
n :INTEGER;
BEGIN
IF max < min THEN RETURN 0; END;
theKeyIndex := (min+max) DIV 2;
strPtr := VAL(StringPtr,GetHeaderAddr(theStack,theStack^^.nameKeys^^[theKeyIndex]));
n := IUCompString(theSearchName,strPtr);
IF n = 0 THEN (* theSearchX matches (indx)^. *)
RETURN theKeyIndex;
ELSIF n < 0 THEN (* theSearchX preceeds (indx)^. *)
RETURN SearchStackByName(min,theKeyIndex-1);
ELSE (* theSearchX follows (indx)^. *)
RETURN SearchStackByName(theKeyIndex+1,max);
END;
END SearchStackByName;
PROCEDURE SearchStackByID(min,max :CARDINAL):CARDINAL;
VAR
header :HeadPtr;
strPtr :StringPtr;
n :INTEGER;
BEGIN
IF max < min THEN RETURN 0; END;
theKeyIndex := (min+max) DIV 2;
header := GetHeaderAddr(theStack,theStack^^.idKeys^^[theKeyIndex]);
IF theSearchID = header^.id THEN
RETURN theKeyIndex;
ELSIF theSearchID < header^.id THEN
RETURN SearchStackByID(min,theKeyIndex-1);
ELSE
RETURN SearchStackByID(theKeyIndex+1,max);
END;
END SearchStackByID;
PROCEDURE NewGrowStack(stack:DataStack):GrowStack;
VAR
gStk :GrowStack;
dPtr :Ptr;
gCards :CARDINAL;
iKeys,nKeys :DataKeysHnd;
keyArrSize,gCardKeyGrow :LONGINT;
BEGIN
WITH stack^^ DO
iKeys := idKeys;
nKeys := nameKeys;
gCardKeyGrow := VAL(LONGINT,growCards)*SIZE(CARDINAL);
dPtr := NewPtr(VAL(LONGINT,cardSize) * VAL(LONGINT,growCards));
IF dPtr = NIL THEN
dataStackErr := MemError();
RETURN NIL;
END;
END;
keyArrSize := GetHandleSize(iKeys);
SetHandleSize(iKeys,keyArrSize + gCardKeyGrow);
IF MemError() # 0 THEN
dataStackErr := MemError();
DisposPtr(dPtr);
RETURN NIL;
END;
SetHandleSize(nKeys,keyArrSize + gCardKeyGrow);
IF MemError() # 0 THEN
dataStackErr := MemError();
SetHandleSize(iKeys,keyArrSize);
DisposPtr(dPtr);
RETURN NIL;
END;
gStk := NewHandle(SIZE(GrowStackRec));
IF gStk = NIL THEN
dataStackErr := MemError();
SetHandleSize(iKeys,keyArrSize);
SetHandleSize(nKeys,keyArrSize);
DisposPtr(dPtr);
RETURN NIL;
END;
WITH gStk^^ DO
filledCards := 0;
dataPtr := dPtr;
growStk := NIL;
END;
RETURN gStk;
END NewGrowStack;
PROCEDURE FindNextGrowCard(stack:DataStack; gStk:GrowStack):HeadPtr;
VAR
header :HeadPtr;
cSize, gCards :CARDINAL;
BEGIN
WITH stack^^ DO
cSize := cardSize;
gCards := growCards;
END;
MoveHHi(gStk);
HLock(gStk);
WITH gStk^^ DO
IF filledCards < gCards THEN
header := VAL(ADDRESS, VAL(LONGCARD,filledCards) * VAL(LONGCARD,cSize)) +
VAL(ADDRESS, dataPtr);
INC(filledCards);
ELSE
IF growStk = NIL THEN
growStk := NewGrowStack(stack);
IF growStk = NIL THEN RETURN NIL; END;
END;
header := FindNextGrowCard(stack,growStk);
END;
END;
HUnlock(gStk);
RETURN header
END FindNextGrowCard;
PROCEDURE AddGrowCard(stack:DataStack):HeadPtr;
VAR gStk :GrowStack;
BEGIN
IF stack^^.growStk = NIL THEN
IF stack^^.growCards = 0 THEN RETURN NIL; END;
gStk := NewGrowStack(stack);
IF gStk = NIL THEN RETURN NIL; END;
stack^^.growStk := gStk;
ELSE
gStk := stack^^.growStk;
END;
RETURN FindNextGrowCard(stack,gStk);
END AddGrowCard;
PROCEDURE FillHeader(stack:DataStack; header:HeadPtr);
VAR
n,totFil :CARDINAL;
start :ADDRESS;
strPtr :StringPtr;
nKeys :DataKeysHnd;
BEGIN
WITH stack^^ DO
INC(idCount);
header^.id := idCount;
idKeys^^[totalFilled] := totalFilled; (* new card always has largest ID. *)
totFil := totalFilled;
nKeys := nameKeys;
END;(*with*)
theStack := stack;
theSearchName := VAL(StringPtr,header);
theKeyIndex := 1; (* default for empty stack *)
n := SearchStackByName(1,totFil-1);
IF (n = 0) AND (totFil > 1) THEN
(* Search failed, and the last index searched was theKeyIndex. *)
strPtr := VAL(StringPtr,GetHeaderAddr(stack,nKeys^^[theKeyIndex]));
IF IUCompString(theSearchName,strPtr) > 0 THEN INC(theKeyIndex) END;
ELSIF (n # 0) THEN
(* search found a card with same name, so we insert the new nameKey there. *)
theKeyIndex := n;
END;
start := ADR(nKeys^^[theKeyIndex]);
BlockMove(start,start+SIZE(CARDINAL),(totFil-theKeyIndex)*SIZE(CARDINAL));
nKeys^^[theKeyIndex] := totFil;
END FillHeader;
PROCEDURE AddCard(stack:DataStack; data:ADDRESS; name:ARRAY OF CHAR):LONGCARD;
VAR
header :HeadPtr;
dest :ADDRESS;
BEGIN
dataStackErr := noErr;
WITH stack^^ DO
IF filledCards = MAX(CARDINAL) THEN
dataStackErr := tooManyCards;
RETURN 0;
END; (* overflow cardLimit? *)
IF filledCards = initialCards THEN (* overflow initial stack space? *)
header := AddGrowCard(stack);
IF header = NIL THEN RETURN 0; END;
ELSE
header := VAL( ADDRESS, VAL(LONGCARD,filledCards) * VAL(LONGCARD,cardSize) )
+ VAL(ADDRESS, dataPtr);
INC(filledCards);
END;
END;
CopyStr(31,name,header^.cName);
INC(stack^^.totalFilled);
FillHeader(stack,header);
dest := VAL(ADDRESS,header) + SIZE(CardHeader); (* data goes just after header. *)
BlockMove(data,dest,VAL(LONGINT,stack^^.cardSize-VAL(CARDINAL,SIZE(CardHeader))));
RETURN header^.id;
END AddCard;
PROCEDURE FindKeyIndex(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL):CARDINAL;
EXTERNAL;
(*
PROCEDURE FindKeyIndex(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL):CARDINAL;
VAR i :CARDINAL;
BEGIN
i := 1;
REPEAT
IF keysArrPtr^[i] = indx THEN RETURN i; END;
INC(i);
UNTIL i > totFil;
RETURN 0;
END FindKeyIndex;
*)
PROCEDURE UpdateCardKeys(keysArrPtr:DataKeysPtr; indx,totFil:CARDINAL);
VAR
targKeyIndx,lastKeyIndx :CARDINAL;
dst :ADDRESS;
BEGIN
(* find index of key pointing to target card. *)
targKeyIndx := FindKeyIndex(keysArrPtr,indx,totFil);
(* find index of key pointing to last card. *)
lastKeyIndx := FindKeyIndex(keysArrPtr,totFil,totFil);
(* replace key to lastCard with indx (new location for lastCard). *)
keysArrPtr^[lastKeyIndx] := indx;
(* move keys up and over indx of key pointing to target. *)
(* dst := VAL(LONGINT,targKeyIndx)*2 + VAL(ADDRESS,keysArrPtr); *)
dst := ADR(keysArrPtr^[targKeyIndx]);
BlockMove(dst+SIZE(CARDINAL),dst,VAL(LONGINT,totFil-targKeyIndx)*SIZE(CARDINAL));
END UpdateCardKeys;
PROCEDURE RemoveLastGrowBlock(stack:DataStack);
VAR growHnd,preGrowHnd :GrowStack;
BEGIN
preGrowHnd := NIL;
growHnd := stack^^.growStk; (* we know growStk is not NIL. *)
WHILE growHnd^^.growStk # NIL DO
preGrowHnd := growHnd;
growHnd := growHnd^^.growStk;
END;
IF preGrowHnd = NIL THEN (* remove first growStk. *)
DisposPtr(stack^^.growStk^^.dataPtr);
DisposHandle(stack^^.growStk);
stack^^.growStk := NIL;
ELSE
DisposPtr(growHnd^^.dataPtr);
DisposHandle(preGrowHnd^^.growStk);
preGrowHnd^^.growStk := NIL;
END;
END RemoveLastGrowBlock;
PROCEDURE RemoveLastCard(stack:DataStack);
VAR growHnd :GrowStack;
BEGIN
growHnd := stack^^.growStk;
IF growHnd = NIL THEN
DEC(stack^^.filledCards);
ELSE
WHILE growHnd^^.growStk # NIL DO
growHnd := growHnd^^.growStk;
END;
IF growHnd^^.filledCards = 1 THEN
RemoveLastGrowBlock(stack);
ELSE
DEC(growHnd^^.filledCards);
END;
END;
DEC(stack^^.totalFilled);
END RemoveLastCard;
PROCEDURE RemoveCard(stack:DataStack; indx:CARDINAL; id:LONGCARD);
VAR
targ,last :HeadPtr;
totFil :CARDINAL;
BEGIN
IF indx > totFil THEN
dataStackErr := indxOutOfRange;
RETURN;
ELSE
dataStackErr := noErr;
END;
(* get card index *)
IF (indx = 0) AND (id # 0) THEN
indx := GetCardIndx(stack,id,"");
END;
totFil := stack^^.totalFilled;
IF (indx = 0) OR (indx > totFil) THEN
dataStackErr := notFound;
RETURN;
END;
(* get target and lastCard addresses *)
targ := GetHeaderAddr(stack,indx);
last := GetHeaderAddr(stack,totFil);
(* replace lastCard keys with indx then shrink keysArrays. *)
UpdateCardKeys(stack^^.idKeys^,indx,totFil);
UpdateCardKeys(stack^^.nameKeys^,indx,totFil);
(* blockmove lastCard over target *)
BlockMove(last,targ,VAL(LONGINT,stack^^.cardSize));
(* remove lastCard and reduce totFil and local filledCards. *)
RemoveLastCard(stack);
END RemoveCard;
PROCEDURE GetCardIndx(stack:DataStack; id:LONGCARD; name:ARRAY OF CHAR):CARDINAL;
VAR n:CARDINAL;
BEGIN
dataStackErr := noErr;
theStack := stack;
IF id # 0 THEN
theSearchID := id;
n := SearchStackByID(1,stack^^.totalFilled);
IF n = 0 THEN
dataStackErr := notFound;
RETURN 0;
END;
RETURN stack^^.idKeys^^[n];
ELSIF name[0] # 0C THEN
theSearchName := ADR(name);
n := SearchStackByName(1,stack^^.totalFilled);
IF n = 0 THEN
dataStackErr := notFound;
RETURN 0;
END;
RETURN stack^^.nameKeys^^[n];
END;
dataStackErr := notFound;
RETURN 0;
END GetCardIndx;
PROCEDURE GetCardID(stack:DataStack; indx:CARDINAL; name:ARRAY OF CHAR):LONGCARD;
VAR header :HeadPtr;
BEGIN
dataStackErr := noErr;
IF indx = 0 THEN
indx := GetCardIndx(stack,0,name);
IF indx = 0 THEN RETURN 0; END;
END;
header := GetHeaderAddr(stack,indx);
IF header = NIL THEN
dataStackErr := notFound;
RETURN 0;
END;
RETURN header^.id;
END GetCardID;
PROCEDURE GetCardName(stack:DataStack; indx:CARDINAL; id:LONGCARD; VAR name:ARRAY OF CHAR);
VAR header :HeadPtr;
BEGIN
dataStackErr := noErr;
name := "";
IF indx = 0 THEN
indx := GetCardIndx(stack,id,"");
IF indx = 0 THEN RETURN END;
END;
header := GetHeaderAddr(stack,indx);
IF header = NIL THEN
dataStackErr := notFound;
RETURN;
END;
CopyStr(31,header^.cName,name);
END GetCardName;
PROCEDURE SetCardName(stack:DataStack; indx,id:CARDINAL; name:ARRAY OF CHAR);
VAR
header :HeadPtr;
strPtr :StringPtr;
oldKeyIndx,totFil,n :CARDINAL;
nKeys :DataKeysHnd;
src,dst :ADDRESS;
BEGIN
dataStackErr := noErr;
totFil := stack^^.totalFilled;
nKeys := stack^^.nameKeys;
IF indx = 0 THEN
indx := GetCardIndx(stack,id,"");
IF indx = 0 THEN RETURN END;
END;
header := GetHeaderAddr(stack,indx);
IF header = NIL THEN
dataStackErr := notFound;
RETURN;
END;
CopyStr(31,name,header^.cName);
IF totFil = 1 THEN RETURN END;
(* get nameKeyIndex for original *)
oldKeyIndx := FindKeyIndex(nKeys^, indx, totFil);
dst := ADR(nKeys^^[oldKeyIndx]);
BlockMove(dst+SIZE(CARDINAL),dst,(totFil-oldKeyIndx)*SIZE(CARDINAL));
(* find nameKeyIndex for new name *)
theStack := stack;
theSearchName := VAL(StringPtr,header);
n := SearchStackByName(1,totFil-1);
IF (n = 0) AND (totFil > 1) THEN
(* Search failed, and the last index searched was theKeyIndex. *)
strPtr := VAL(StringPtr,GetHeaderAddr(stack,nKeys^^[theKeyIndex]));
IF IUCompString(theSearchName,strPtr) > 0 THEN INC(theKeyIndex) END;
ELSIF (n # 0) THEN
(* search found a card with same name, so we insert the new nameKey there. *)
theKeyIndex := n;
END;
src := ADR(nKeys^^[theKeyIndex]);
BlockMove(src,src+SIZE(CARDINAL),(totFil-theKeyIndex)*SIZE(CARDINAL));
nKeys^^[theKeyIndex] := indx;
END SetCardName;
PROCEDURE CountCards(stack:DataStack):CARDINAL;
BEGIN
RETURN stack^^.totalFilled;
END CountCards;
PROCEDURE GetCardByIndx(stack:DataStack; indx:CARDINAL):ADDRESS;
VAR a :ADDRESS;
BEGIN
dataStackErr := noErr;
a := VAL(ADDRESS,GetHeaderAddr(stack,indx));
IF a = NIL THEN
dataStackErr := notFound;
RETURN NIL;
ELSE
RETURN a + SIZE(CardHeader);
END;
END GetCardByIndx;
PROCEDURE GetCardByID(stack:DataStack; id:LONGCARD):ADDRESS;
VAR a :ADDRESS;
BEGIN
dataStackErr := noErr;
a := VAL(ADDRESS,GetHeaderAddr(stack,GetCardIndx(stack,id,"")));
IF a = NIL THEN
dataStackErr := notFound;
RETURN NIL;
ELSE
RETURN a + SIZE(CardHeader);
END;
END GetCardByID;
PROCEDURE GetCardByName(stack:DataStack; name:ARRAY OF CHAR):ADDRESS;
VAR a :ADDRESS;
BEGIN
dataStackErr := noErr;
a := VAL(ADDRESS,GetHeaderAddr(stack,GetCardIndx(stack,0,name)));
IF a = NIL THEN
dataStackErr := notFound;
RETURN NIL;
ELSE
RETURN a + SIZE(CardHeader);
END;
END GetCardByName;
PROCEDURE ForAllCardsDo(stack:DataStack; do:DoProc);
VAR i :CARDINAL;
BEGIN
FOR i := 1 TO stack^^.totalFilled DO
do(VAL(ADDRESS,GetHeaderAddr(stack,i)) + SIZE(CardHeader));
END;
END ForAllCardsDo;
PROCEDURE InIDOrderDo(stack:DataStack; do:DoProc);
VAR i,n :CARDINAL;
BEGIN
FOR i := 1 TO stack^^.totalFilled DO
n := stack^^.idKeys^^[i];
do(VAL(ADDRESS,GetHeaderAddr(stack,n)) + SIZE(CardHeader));
END;
END InIDOrderDo;
PROCEDURE InNameOrderDo(stack:DataStack; do:DoProc);
VAR i,n :CARDINAL;
BEGIN
FOR i := 1 TO stack^^.totalFilled DO
n := stack^^.nameKeys^^[i];
do(VAL(ADDRESS,GetHeaderAddr(stack,n)) + SIZE(CardHeader));
END;
END InNameOrderDo;
END DataStacks.